IniReadDouble Function

public function IniReadDouble(key, iniDB, section, subSection, default)

read an double precision number corresponding to Key

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: key
type(IniList), intent(in) :: iniDB
character(len=*), intent(in), optional :: section
character(len=*), intent(in), optional :: subSection
real(kind=double), intent(in), optional :: default

Return Value real(kind=double)


Variables

Type Visibility Attributes Name Initial
character(len=stringLen), public :: s

Source Code

FUNCTION IniReadDouble &
!
(key, iniDB, section, subSection, default)

IMPLICIT NONE

! subroutine arguments 
! Scalar arguments with intent(in):
CHARACTER (LEN = *),           INTENT(IN) :: key
TYPE (IniList),                INTENT(IN) :: iniDB
CHARACTER (LEN = *), OPTIONAL, INTENT(IN) :: section
CHARACTER (LEN = *), OPTIONAL, INTENT(IN) :: subSection
REAL(KIND = double), OPTIONAL, INTENT(IN) :: default
! Scalar arguments with intent(out):
REAL (KIND = double)                      :: IniReadDouble 
! Local Scalars:
CHARACTER(LEN = stringLen) :: s
!------------end of declaration------------------------------------------------
   
IF ( PRESENT (section) .AND. PRESENT (subSection) ) THEN
	s = IniReadString(key, iniDB, section = section, subSection = subSection)
ELSE IF ( PRESENT (section) .AND. .NOT.PRESENT (subSection)) THEN
	s = IniReadString(key, iniDB, section = section)
ELSE
	s = IniReadString(key, iniDB)
ENDIF
  
IF (s == '') THEN
   IF ( PRESENT (default) )THEN
     IniReadDouble = default
   ELSE
     CALL Catch ('error', 'read ini file',              &
				 'key not found: ' , code = iniIOError, &
				 argument = key )
   ENDIF
ELSE
   READ (s,*, IOSTAT = ios) IniReadDouble
   IF (ios > 0) THEN
     CALL Catch ('error', 'read ini file',           &
				 'error reading double for key: ' ,  &
				 code = iniIOError, argument = key )
   ENDIF
END IF

RETURN

END FUNCTION IniReadDouble